home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / CASE.SEQ < prev    next >
Text File  |  1988-05-13  |  1KB  |  32 lines
  1. \ CASE.SEQ      Case statment                           by Bob Smith
  2.  
  3. comment:        \ Moved to the kernel
  4.  
  5. CODE (OF)       ( n1 n2 -- n1 )  ( or )  ( n1 n1 -- )
  6.                 AX POP   RP SP XCHG   0 [RP] AX CMP   0=
  7.                 IF    SP RP XCHG   AX POP   IP INC   IP INC   NEXT
  8.                 ELSE  SP RP XCHG   0 [IP] IP MOV   NEXT
  9.                 THEN   END-CODE
  10.  
  11. comment;
  12.  
  13. : CASE          ( -- )
  14.                 <MARK 0 ;                                       IMMEDIATE
  15.  
  16.  
  17. : ENDOF         ( -- )
  18.                 COMPILE BRANCH >MARK SWAP >RESOLVE ;            IMMEDIATE
  19.  
  20. : OF            ( n1 n2 -- n1 )  ( n1 n1 -- )
  21.                 COMPILE (OF)  >MARK ;                           IMMEDIATE
  22.  
  23. : NRESOLVE   ( 0 n1 n2 ... n -- )
  24.                 BEGIN   DUP
  25.                         IF      >RESOLVE 0
  26.                         ELSE    -1  THEN
  27.                 UNTIL   DROP ;
  28.  
  29. : ENDCASE       ( -- )
  30.                 NRESOLVE DROP ;                                 IMMEDIATE
  31.  
  32.